/*
 *  prim.c
 *  scheme2
 *
 *  Created by Leo Katzenstein on 5/26/07.
 *  Copyright 2007 __MyCompanyName__. All rights reserved.
 *
 */

#include "scheme.h"

static long suml(Pair *l)
{
	long sum = 0;
	for (; l; l=l->cdr)
	{
		if (is_number(l->car))
			sum += nval(l->car);
		else
			error("expected numeric type, got non-numeric type");
	}
	return sum;
}

static long mull(Pair *l)
{
	long prod = 1;
	for (; l; l=l->cdr)
	{
		if (is_number(l->car))
			prod *= nval(l->car);
		else
			error("expected numeric type, got non-numeric type");
	}
	return prod;
}

/*
Pair *fplus( Pair *arglist )
{
	long sum;
	sum = suml( arglist );
	return make_num( sum );
}
*/

Pair *fplus(Pair *arglist)
{
	long sum;
	double d;

	sum = 0;
	for (; arglist; arglist = arglist->cdr)
	{
		if (is_fixnum(arglist->car))
			sum += nval(arglist->car);
		else
			goto dbl;
	}
	return make_num(sum);

dbl:
	d = sum;
	for (; arglist; arglist = arglist->cdr)
	{
		if (is_fixnum(arglist->car))
			d += nval(arglist->car);
		else if (is_double(arglist->car))
			d += dval(arglist->car);
		else
			error("expected numeric type, got non-numeric type");
	}
	return make_double(d);
}

Pair *fminus(Pair *arglist)
{
	long sum;

	if (arglist == NULL)
		error("Error: \"-\" got 0 args, wanted at least 1 arg.");

	if (is_number(arglist->car))
		sum = nval(arglist->car);
	else
		error("non-numeric type in minus");

	if (arglist->cdr == NULL) {
		sum = -sum;		/* only one argument */
	} else {
		sum -= suml(arglist->cdr);
	}
	return make_num(sum);
}

Pair *fprod(Pair *arglist)
{
	long prod;
	prod = mull(arglist);
	return make_num(prod);
}

Pair *fdiv(Pair *arglist)
{
	long prod;

	if (arglist == NULL)
          error("Error: \"-\" got 0 args, wanted at least 1 arg.");

	if (is_number(arglist->car))
		prod = nval(arglist->car);
	else
		error("non-numeric type in minus");

	if (arglist->cdr == NULL) {
		prod = 1 / prod;	/* only one argument */
	} else {
		prod /= mull(arglist->cdr);
	}
	return make_num(prod);
}

Pair *fexit(Pair *arglist)
{
  int stat;
  if (arglist == NULL)
    error("Error: \"-\" got 0 args, wanted 1 arg.");
  else if (arglist->cdr != NULL)
    error("Error: \"-\" got 2 or more args, wanted 1 arg.");

  if (arglist->car == NULL)
    exit(1);    /* exit with null is error */
  else
    exit(0);
  return NULL;
}

/* equality testing */
Pair *feq(Pair *arglist)
{
  Pair *x, *y;
  if (arglist == NULL ||
      arglist->cdr == NULL ||
      arglist->cdr->cdr != NULL )
    error("Error: eq wants exactly 2 arguments.");
  x = arglist->car;
  y = arglist->cdr->car;
  if (is_fixnum(x) && is_fixnum(y) && nval(x) == nval(y))
    return t;
  else if (is_double(x) && is_double(y) && dval(x) == dval(y))
    return t;
  else if (x == y)
    return t;
  else
    return NULL;
}
